home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / Nov / di9811pd / Gmp.pas < prev    next >
Pascal/Delphi Source File  |  1998-07-03  |  52KB  |  1,418 lines
  1. unit gmp;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, WinProcs, WinTypes, SysUtils, Classes, Graphics, Controls, Forms,
  7.   Dialogs, stdctrls, ExtCtrls, DIB16, Math;
  8.  
  9. const
  10.   {You can just change these constants instead of hunting through the code
  11.   to restrict the number of polygons.  The MaxPoints should allways be 4*
  12.   the number of MaxPolys}
  13.   MAXPOLYS = 100;
  14.   MAXPOINTS = 400;
  15.  
  16. type
  17.  
  18. TRenderMode = (rmWireframe, rmSolid, rmSolidShade, rmSolidTexture, rmShadedTexture);
  19.  
  20. TYBucket = record
  21.   StartX, EndX : Integer;
  22. end;
  23.  
  24. TTextureBucket = record
  25.   StartPosition, EndPosition : TPoint;
  26. end;
  27.  
  28. TPoint3D = record
  29.   X, Y, Z : single;
  30. end;
  31.  
  32. TLine3D = record
  33.   StartPoint, EndPoint : TPoint3D;
  34. end;
  35.  
  36. TPolygon = record
  37.   Point : array [0..3] of TPoint3D; {only allow polygons for now if to 4 points}
  38.   NumberPoints : Integer;
  39.   Visible : Boolean;
  40.   AverageZ : Single;
  41.   PolyColor : TColor;  {Color of the polygon}
  42.   DibColor : Word;     {Word color value of PolyColor}
  43.   Intensity : Byte;    {The light intensity of the polygon}
  44. end;
  45.  
  46. TObject3D = record
  47.   PolyStore  : array [0..MAXPOLYS] of TPolygon; {Stores the local coordinates}
  48.   PolyWorld  : array [0..MAXPOLYS] of TPolygon; {Stores the world coordinates}
  49.   PolyCamera : array [0..MAXPOLYS] of TPolygon; {Stores the camera coordinates}
  50.   NumberPolys : Integer; {Number of Polygons}
  51.   Color : Tcolor; {Color of whole object - used in wireframe and solid color modes}
  52.   DibColor : Word; {16bit color of whole object - used in wireframe and solid color modes}
  53.   World : TPoint3D; {Position of the object in the world}
  54. end;
  55.  
  56. TPObject3D = ^TObject3D; {Pointer to TObject3D}
  57.  
  58. TBeforeFlip = procedure (Canvas : TCanvas) of object; {Declaration for an event}
  59.  
  60. TBitmapStorage = array [0..127, 0..127] of Word; {Declaration for Bitmap Storage}
  61.  
  62. TGMP = class(TCustomControl)
  63.   private
  64.     { Private declarations }
  65.     FCurrentBitmap : TBitmapStorage; {Storage for the current bitmap}
  66.     FDib : TDib16Bit; {The DIB class back buffer}
  67.     FForegroundDIB : TDib16Bit; {Stores the foreground bitmap}
  68.     FAlign: TAlign; {Alignment of TGMP window}
  69.     FBeforeFlip : TBeforeFlip; {Flip event member}
  70.     FBackBuffer : TBitmap;  {Used to assign the FDIB handle to for use with the GDI}
  71.     FColor : TColor;  {Used to hold a temporary color value in drawing polygons}
  72.     FDibColor : Word; {Used to hold a temporary color value in drawing polygons}
  73.     FIntensity : Byte; {Used to hold a temporary light intensity value in drawing polygons}
  74.     ViewWidth, ViewHeight : Integer;
  75.     FRenderMode : TRenderMode;
  76.     HalfScreenWidth, HalfScreenHeight, ViewingDistance : Integer;
  77.     FPointer : Pointer;
  78.     YBuckets : array [0..479] of TYBucket; {480 being the most we will allow the screen height to go up to}
  79.     TextureBuckets : array [0..479] of TTextureBucket; {480 being the most we will allow the screen height to go up to}
  80.     IntensityLUT : Array [0..31, 0..31] of Integer; {The light intensity lookup table}
  81.     FLightStrength : Single;
  82.     AmbientLight : Integer; {The amount of ambient light in the scene}
  83.     TransLightSource : TPoint3D;
  84.     FAnimationList : TList; {Holds a list of all the animation frames}
  85.     FForegroundBitmap : TPicture; {Holds the foreground bitmap}
  86.     FEnableForeground : Boolean; {Wether or not the foreground is enabled}
  87.     procedure DrawLine3D(X1, Y1, Z1, X2, Y2, Z2 : Single);
  88.     procedure DrawLine2DWireframe(X1, Y1, X2, Y2 : Integer);
  89.     procedure DrawLine2DSolid(X1, Y1, X2, Y2 : Integer);
  90.     procedure SetBackColor(Value : TColor);
  91.     procedure GetVector3D(var EndPoint, StartPoint, Vector : TPoint3D);
  92.     procedure CrossProduct(var U, V, Normal : TPoint3D);
  93.     procedure GetNormal(var P1, P2, P3, normal : TPoint3D);
  94.     function VectorMagnitude(var Normal : TPoint3D) : Single;
  95.     function DotProduct(var U, V : TPoint3D) : Single;
  96.     procedure RemoveBackfacesAndShade(var AnObject : TObject3D);
  97.     procedure ClearYBuckets;
  98.     procedure DrawHorizontalLine (Y, X1, X2 : Integer) ;
  99.     procedure RenderYBuckets ;
  100.     procedure OrderZ(var Object3D : TObject3D);
  101.     procedure Paint; Override;
  102.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  103.     procedure DrawLine3DTexture(var StartPoint, EndPoint : TPoint3D; var TextStart, TextEnd : TPoint);
  104.     procedure DrawLine2DTexture(var StartPoint, EndPoint, TextStart, TextEnd : TPoint);
  105.     function CalculateRGBWord(Color : TColor) : Word;
  106.     procedure LocalToWorld(var AnObject : TObject3D);
  107.     procedure WorldToCamera(var AnObject : TObject3D);
  108.     Procedure CalcIntensityLUT;
  109.     function GetShadedWord (Texture : Word; Intensity : Integer) : Word;
  110.     procedure RotatePoint(X, Y, Z, Angle : Single; var Point : TPoint3D);
  111.     procedure CopyForeground;
  112.     procedure SetForegroundBitmap ( Value : TPicture );
  113.     function GetForegroundBitmap : TPicture;
  114.     procedure SetEnableForeground ( Value : Boolean );
  115.   protected
  116.     { Protected declarations }
  117.   public
  118.     { Public declarations }
  119.     ViewPoint, LightSource : TPoint3D; {LightSource and Viewpoint positions}
  120.     CameraPosition : TPoint3D; {The camera position}
  121.     CameraRotation : TPoint3D; {The camera rotation}
  122.     constructor Create(AOwner : TComponent) ; override;
  123.     destructor Destroy; override;
  124.     procedure ClearBackPage;
  125.     procedure RenderNow(var Object3D : TObject3D);
  126.     procedure FlipBackPage;
  127.     procedure Rotate(X, Y, Z, Angle : Single; var Object3D : TObject3D);
  128.     procedure ChangeObjectColor(var Object3D : TObject3D; Color : TColor);
  129.     procedure SetLightSourcePosition(Position, Direction : TPoint3D);
  130.     procedure SetCurrentBitmap(Bitmap : TBitmap);
  131.     procedure SetCurrentBitmapWithAnimationFrame ( Frame : Integer );
  132.     procedure DeleteAnimationFrame ( Frame : Integer );
  133.     procedure AddAnimationFrame ( Bitmap : TBitmap );
  134.     function LoadGeoObject(var AnObject : TObject3D; Filename : String) : Integer;
  135.   published
  136.     { Published declarations }
  137.     property Align;
  138.     property LightStrength : Single read FLightStrength write FLightStrength;
  139.     property BackColor : TColor read FColor write SetBackColor;
  140.     property EnableForegroundBitmap : Boolean read FEnableForeground write SetEnableForeground;
  141.     property ForegroundBitmap : TPicture read GetForegroundBitmap write SetForegroundBitmap;
  142.     property RenderMode : TRenderMode read FRenderMode write FRenderMode;
  143.     property BeforeFlip : TBeforeFlip read FBeforeFlip write FBeforeFlip;
  144.     property OnMouseMove;
  145.     property OnMouseDown;
  146.     property OnMouseUp;
  147.   end;
  148.  
  149. procedure Register;
  150.  
  151. implementation
  152.  
  153. function TGMP.GetShadedWord (Texture : Word; Intensity : Integer) : Word;
  154. var
  155.   intRed, intGreen, intBlue : Integer;
  156.   intBitMask : Integer;
  157. begin
  158.  
  159.   {Bitmask for 0000000000011111 is 31 - this gives us the last 5 bits for Blue}
  160.   intBitMask := 31;
  161.   intBlue := Texture and intBitMask;
  162.  
  163.   {Bitmask for 0000001111100000 is 992 - this gives us the the middle 5 bits for Green}
  164.   intBitMask := 992;
  165.   intGreen := Texture and intBitMask;
  166.   intGreen := intGreen shr 5;
  167.  
  168.   {Bitmask for 0111110000000000 is 31744 - this gives the the bits for the Red element - bits 15-11}
  169.   intBitMask := 31744;
  170.   intRed := Texture and intBitMask;
  171.   intRed := intRed shr 10;
  172.  
  173.   {Now get the new shades - this uses the lookup table that we worked out previously}
  174.   intRed := IntensityLUT[intRed, Intensity];
  175.   intGreen := IntensityLUT[intGreen, Intensity];
  176.   intBlue := IntensityLUT[intBlue, Intensity];
  177.  
  178.   {Lastly we just shift the Red and Green into their correct places and add all the elements together}
  179.   intRed := intRed shl 10;
  180.   intGreen := intGreen shl 5;
  181.  
  182.   result := intRed + intBlue + intGreen;
  183. end;
  184.  
  185. Procedure TGMP.CalcIntensityLUT;
  186. var
  187.   X, Y: Integer;
  188.   UpIncrement, DownIncrement : Single;
  189. begin
  190.   {loop through for every possible R,G or B Value - 0 to 31}
  191.   for X := 0 to 31 do
  192.     begin
  193.       {The up increment is from the initial color value to it's brightest}
  194.       UpIncrement := (31 - X) / 16;
  195.       {The down increment is from the initial color value to it's darkest}
  196.       DownIncrement :=